home *** CD-ROM | disk | FTP | other *** search
/ Libris Britannia 4 / science library(b).zip / science library(b) / PROGRAMM / PASCAL / 0191.ZIP / FINDUP32.PAS < prev    next >
Pascal/Delphi Source File  |  1986-01-15  |  61KB  |  1,343 lines
  1. program FindDuplicateFiles;
  2. {   ╔══════════════════════════════════════════════════════════════════════╗
  3.     ║  Copyright March 25, 1985                                            ║
  4.     ║                                                                      ║
  5.     ║  It must  not be sold to anyone for any purpose it has been placed   ║
  6.     ║  in the public  domain for the use of computer hackers who love to   ║
  7.     ║  play with their machines.                                           ║
  8.     ╠══════════════════════════════════════════════════════════════════════╣
  9.     ║                Version 1.0 by Karson Morrison                        ║
  10.     ║                                                                      ║
  11.     ║       Anyone who modifies this program place your name and the new   ║
  12.     ║       version number by it.  Place a comment before and after your   ║
  13.     ║       changes  and  place  the  version  number  as  part of those   ║
  14.     ║       comments.                                                      ║
  15.     ║                                                                      ║
  16.     ║       Please  send  me a copy of the changes that you have made so   ║
  17.     ║       that I may include them in the master.  I don't have all the   ║
  18.     ║       answers I just  started  it.  I am not very knowledgeable at   ║
  19.     ║       Pascal and  I may have made some routines that could be made   ║
  20.     ║       more efficient  by  using  other  coding.  If you find those   ║
  21.     ║       please  let  me  know  and  I  will include them to make the   ║
  22.     ║       program faster.  I cannot make the sort  any  faster because   ║
  23.     ║       it was coded by  Borland.  Anyone  who  sends  me  changes I   ║
  24.     ║       will  include on  a list  that  I will notify of all changes   ║
  25.     ║       that are made to the program.  Keep those cards and  letters   ║
  26.     ║       flowing.                                                       ║
  27.     ╠══════════════════════════════════════════════════════════════════════╣
  28.     ║  This is a program to list out all of the files on a  disk  sorted   ║
  29.     ║  in file order.  It  will  also  tell you of any  duplicate  files   ║
  30.     ║  within different directories.   (See Version 2.0 changes)           ║
  31.     ╠══════════════════════════════════════════════════════════════════════╣
  32.     ║  Requirements:                                                       ║
  33.     ║                                                                      ║
  34.     ║  This program  requires  Turbo  Pascal  2.0  and the Turbo Toolbox   ║
  35.     ║  pascal  program  SORT.BOX.  The .COM  version  has  already  been   ║
  36.     ║  compiled with the SORT in it.                                       ║
  37.     ╠══════════════════════════════════════════════════════════════════════╣
  38.     ║  This program was written by and Copyright (C) 1985 by               ║
  39.     ║                                                                      ║
  40.     ║                              Karson W. Morrison                      ║
  41.     ║                              RD. 1, Box 531,                         ║
  42.     ║                              Ringoes, NJ. 08551                      ║
  43.     ║                              (201) 788-1846                          ║
  44.     ╠══════════════════════════════════════════════════════════════════════╣
  45.     ║  Acknowledgements:                                                   ║
  46.     ║                                                                      ║
  47.     ║  I used info picked up from a  bulletin  board  for  the  routines   ║
  48.     ║  to get system date and time.  That info. was created by  Jon Gray   ║
  49.     ║  of the IBM PC USERS GROUP Milwaukee.  It did have  a  bug  though   ║
  50.     ║  that would only work with months of 2 digits (now fixed by me).     ║
  51.     ║                                                                      ║
  52.     ║  I  also  used  routines  provided  by  Borland for the reading of   ║
  53.     ║  directories. This info was provided in their Turbo Tutor package.   ║
  54.     ║                                                                      ║
  55.     ║  Tears:                                                              ║
  56.     ║                                                                      ║
  57.     ║  A lot of hours went into this program please do not revise it and   ║
  58.     ║  leave out the credit that I have done most of the work.             ║
  59.     ║                                                                      ║
  60.     ║  Purpose:                                                            ║
  61.     ║                                                                      ║
  62.     ║  Every time I turned  around I  was  trying  to delete some of the   ║
  63.     ║  files on my hard disk because I was  always  ending  up with only   ║
  64.     ║  300 - 400 K left.  I kept  thinking  there  must be an easier way   ║
  65.     ║  to know if there were duplicate files.                              ║
  66.     ║                                                                      ║
  67.     ║                     This is the result                               ║
  68.     ╠══════════════════════════════════════════════════════════════════════╣
  69.     ║                Version 2.0   March 25, 1985                          ║
  70.     ║                    Made by the author.                               ║
  71.     ║                                                                      ║
  72.     ║  Updated program to put file size on  each line and put in a major   ║
  73.     ║  option for Sorted Tree Directories.                                 ║
  74.     ║                                                                      ║
  75.     ║  Every Tree Dir program that I have seen always  intersperces  sub   ║
  76.     ║  directories files where it finds them  with  the regular files in   ║
  77.     ║  that directory.  This program  put  files  together,  followed by   ║
  78.     ║  the sub directory files in  that directory.  The sub  directories   ║
  79.     ║  are sorted, and  then  printed  in  the  sorted  order within the   ║
  80.     ║  the parent directory.                                               ║
  81.     ║                                                                      ║
  82.     ║  Updated program to put output on a file DIRECTRY.DTA as an option   ║
  83.     ║  for later printing or other modification.                           ║
  84.     ╠══════════════════════════════════════════════════════════════════════╣
  85.     ║                Version 2.01   April 23, 1985                         ║
  86.     ║                    Made by the author.                               ║
  87.     ║                                                                      ║
  88.     ║  Made a change to increase the valid characters  that may be  in a   ║
  89.     ║  file name.  The 7Fh, DEL  char  may  be  in  a file name there by   ║
  90.     ║  making the file name unable to be entered from the keyboard.        ║
  91.     ║                                                                      ║
  92.     ║  This also is used to make a directory hidden.                       ║
  93.     ║  Fix the line which prints on the screen when a report is being      ║
  94.     ║  produced on paper.                                                  ║
  95.     ╠══════════════════════════════════════════════════════════════════════╣
  96.     ║              Version 2.02  July 28, 1985                             ║
  97.     ║                   Made by the author.                                ║
  98.     ║                                                                      ║
  99.     ║  Made a change to put a Clrscr in at the beginning of the program.   ║
  100.     ║  This was necessary if you use the Public Domain program to reset    ║
  101.     ║  the clear screen at the begining of the program.                    ║
  102.     ║  Turbo 3.0 also doesn't clear screen at beginning of program.        ║
  103.     ╠══════════════════════════════════════════════════════════════════════╣
  104.     ║             Version 2.03 September 9, 1985                           ║
  105.     ║                    Made by the author.                               ║
  106.     ║                                                                      ║
  107.     ║  Made a change to calculate to space used for 1K blocks which is     ║
  108.     ║  what is used when the data is stored on a floppy.                   ║
  109.     ╠══════════════════════════════════════════════════════════════════════╣
  110.     ║             Version 2.04 November 11, 1985                           ║
  111.     ║                     Made by author                                   ║
  112.     ║                                                                      ║
  113.     ║  Made a change to the first screen so that it would be easier to     ║
  114.     ║  understand the options.  Included Windows by Lynn Canning,          ║
  115.     ║  with the original code by Lane Farris.                              ║
  116.     ╠══════════════════════════════════════════════════════════════════════╣
  117.     ║             Version 3.00 December 14, 1985                           ║
  118.     ║                     Made by author                                   ║
  119.     ║  This version now requires Turbo 3.0                                 ║
  120.     ║                                                                      ║
  121.     ║  This version now will read multiple hard disks and floppies and     ║
  122.     ║  do its thing on the file names.                                     ║
  123.     ║                                                                      ║
  124.     ║       Option 1, 2, 4 will allow you to go to the screen, printer     ║
  125.     ║                      or disk file.                                   ║
  126.     ║       Option 3 will only go to disk file 'DIRECTRY.DTA' for the      ║
  127.     ║                directory and 'DUPLICAT.DTA' for the duplicate        ║
  128.     ║                entries.                                              ║
  129.     ║                                                                      ║
  130.     ║       Option 4 Sorted Tree Directory uses the Drive letter as its    ║
  131.     ║                major sort key.  Therefore it will not mix up file    ║
  132.     ║                and directories names from multiple drives.           ║
  133.     ║                                                                      ║
  134.     ║  This version of the program also supports floppies.  The program    ║
  135.     ║  would read them before but the output was not too useful because    ║
  136.     ║  only one floppy could be read at a time.  *** NOW *** the program   ║
  137.     ║  asks you if you are reading a hard drive or a floppy.  Nothing      ║
  138.     ║  happens to the machine if you answer the wrong answer, it is to     ║
  139.     ║  allow me to know if I should VolumeID the disk (I don't on Hard     ║
  140.     ║  Disks).  If you want me to Volume-ID a floppy just enter the data   ║
  141.     ║  (What you enter will also show on the report as the main directory  ║
  142.     ║  If you don't enter a Volume-ID (return) I show the name 'FLOPPYnnn' ║
  143.     ║  as the main directory. (nnn is the number of the diskette entered)  ║
  144.     ║                                                                      ║
  145.     ║  If you want to speed up the entry process, and you have two or more ║
  146.     ║  floppy drives run the program as FINDDUPE AB.  The program will     ║
  147.     ║  alternate between the drives.  (NOTE:) one problem in using this    ║
  148.     ║  feature you must have a floppy for both A and B drives. (You could  ║
  149.     ║  place a blank formatted floppy in the last B: drive to insure       ║
  150.     ║  the completion of the input phase.)                                 ║
  151.     ║                                                                      ║
  152.     ║  Included into version 3.00 are changes made by Ray Bobak as he      ║
  153.     ║  noted below.                                                        ║
  154.     ║                                                                      ║
  155.     ║                Version 2.1   October 27, 1985                        ║
  156.     ║                  Modifications by Ray Bobak                          ║
  157.     ║                     Sysop PC-RAIN Node II                            ║
  158.     ║                     Wappingers Falls, NY                             ║
  159.     ║                     914-462-7674 (data)                              ║
  160.     ║                                                                      ║
  161.     ║  Updated code so that the input string from the command line was a   ║
  162.     ║  list of drives to perform the services on.  This change was made    ║
  163.     ║  to allow SYSOP's with multiple download drives to scan all his      ║
  164.     ║  download drives for duplicates.  (Here you go Charlie, your name    ║
  165.     ║  in lights.)  This version was inspired by Charlie Innusa, a sysop   ║
  166.     ║  running RBBS-PC on only nine 32 Megabyte download drives.  You can  ║
  167.     ║  call his BBS, PC-Rockland at 914-353-2157 Subscription node, or     ║
  168.     ║                               914-353-2176 free node                 ║
  169.     ║                                                                      ║
  170.     ║  FINDDUPE ABCDEF - find duplicate files across drives A, B, C, ...   ║
  171.     ║                    approximate time to handle 10K files = 20 Min     ║
  172.     ║                    for reading of directory and sorting.  Note,      ║
  173.     ║                    sort will need 800K of diskspace for the sort.    ║
  174.     ║                                                                      ║
  175.     ╠══════════════════════════════════════════════════════════════════════╣
  176.     ║               Version 3.1 made by author                             ║
  177.     ║   Fix in the DOS time routine for hours less than 10 A.M.            ║
  178.     ║              Changes made December 29, 1985                          ║
  179.     ╠══════════════════════════════════════════════════════════════════════╣
  180.     ║              Version 3.2 made by author                              ║
  181.     ║   Changes in the way that the output was written to a file when in   ║
  182.     ║   floppy mode.  So that the output file goes to a new floppy.        ║
  183.     ╚══════════════════════════════════════════════════════════════════════╝
  184.     ╔══════════════════════════════════════════════════════════════════════╗
  185.     ║  Yours for better Computing                                          ║
  186.     ║                             Karson W. Morrison Caleb Computing Center║
  187.     ╚══════════════════════════════════════════════════════════════════════╝
  188.  
  189.     ╔══════════════════════════════════════════════════════════════════════╗
  190.     ║                                                                      ║
  191.     ║  NOTE:                                                               ║
  192.     ║                                                                      ║
  193.     ║  A command line is used as input if entered else the default drive   ║
  194.     ║  is used.                                                            ║
  195.     ╚══════════════════════════════════════════════════════════════════════╝
  196. }
  197. const
  198.   Max_dir              = 300;   { Max number of directory entries }
  199.                                     { it can be upped }
  200. { Changes for 2.04 }
  201.   MaxWin               = 1;     { Max number of windows open at a time }
  202. { Above Changes for 2.04 }
  203. type
  204.   DirRec =                               { My Sort Record }
  205.     record
  206.         FileDrive      : string[1];      { Drive leter of file} {3.0}
  207.         FileNme        : string[14];     { File Name }
  208.         FileDir        : string[36];     { Concatinated Directory Tree }
  209.         FileAttributes : string[5];      { Codes for System, hidden, dir etc. }
  210.         FileMO         : integer;        { File creation Month }
  211.         FileDA         : integer;        { File creation Day }
  212.         FileYR         : integer;        { File creation Year }
  213.         FileHR         : integer;        { File creation Hour  24 hour clock }
  214.         FileMN         : integer;        { File creation Minute 60 min clock }
  215.         FileSiLow      : integer;        { Low order byte file size }
  216.         FileSiHigh     : integer;        { High order byte file size }
  217.     end;
  218.   SortSave             = ^Byte;
  219.   String20             = string [ 20 ];
  220.   RegRec =                               { The data to pass to DOS }
  221.     record
  222.       AX, BX, CX, DX, BP, SI, DI, DS, ES, Flags : Integer;
  223.     end;
  224.  
  225. var
  226.   FilVar               : text;                      { Is it CON: or LST: }
  227.   FilVar1              : text;                      { Is it CON: or LST: }
  228.   DirectryRec          : DirRec;
  229.   DiskOutput,                            { Do we want Disk output }
  230.   Print,                                 { Do we want paper or screen }
  231.   FirstTime,                             { First time in this routine }
  232.   DirCont,                               { is this dir on the previous page }
  233.   NotDir               : Boolean;        { This is not a directory rec I read }
  234.   Regs                 : RegRec;         { Dos Registers }
  235.   DTA                  : array [ 1..43 ] of Byte;  { Back from DOS }
  236.   Mask                 : array [ 1..50 ] of Char;  { What do we read DOS calls }
  237.   NamR                 : String20;       { The file name from the DTA }
  238.   SaveFile             : SortSave;       { Save this type in a getmen instr }
  239.   timestr              : string[11];     { like it says }
  240.   datestr              : string[15];     {     "        }
  241.   ErrResult,                             { Error Switches }
  242.   Error,
  243.   XDir, YDir, I, Z     : Integer;        { screen position }
  244.   Buffer,                                { Used in file name manipulation }
  245.   Buffer1,                               {               "                }
  246.   Buffer2              : String [50];    {               "                }
  247.   DirTable             : Array [ 1..Max_dir ] of string[50];  { Dirs Found }
  248.   E, E_use,                              { Working integers }
  249.   A, B, C,                               {        "         }
  250.   PageNo               : integer;        { Page being printed }
  251.   PageNoDup            : integer;        { Page being printed }
  252.   OldName              : string [14];    { Work areas for duplicate check }
  253.   OldDir               : string [36];    { Same as DirRec }
  254.   OldAttr              : string[5];           { " }
  255.   OldHi,                                      { " }
  256.   OldLo,                                      { " }
  257.   OldMO,                                      { " }
  258.   OldDA,                                      { " }
  259.   OldYR,                                      { " }
  260.   OldHR,                                      { " }
  261.   OldMN                : integer;             { " }
  262.   OldSI                : real;                { " }
  263.   WrkMN                : string[2];      { Work Month }
  264.   WorkName             : string[14];
  265. { Change for version 2.04  Following Option was changed to Char }
  266.   Option               : char;           { What option did you want from screen }
  267.   Option1              : char;           { What option did you want from screen }
  268.   Option2              : char;         { Is this a Hard Drive or Floppy }
  269. { Above change made for 2.04 }
  270.   ReadDefaultDrive,                    { Am I reading my default drive }
  271.   HardDrive,                           { Do I have a hard drive or floppies }
  272.   MatchFound           : Boolean;      { Oh! Oh! you have two files the same }
  273.   FloppyNumber,                        { How many floppies have I read }
  274.   ScreenLines          : integer;      { How many lines I've printed }
  275.   ScreenLines1         : integer;      { How many lines I've printed }
  276.   Temp                 : string[1];    { This is not the Temperature }
  277.   SortResult,                          { Did the sort work }
  278.   FileDateDos,                         { Dos format for date }
  279.   FileHourDos,                         { Dos format for Hour }
  280.   FileYear,                            { File Year actual not just since 1980 }
  281.   FileMonth,                           { File month }
  282.   FileDay,                             { File Day }
  283.   FileHour,                            { File Hour }
  284.   FileMinute,                          { File Minute }
  285.   FileWork,                            { Work area }
  286.   FileWork2,                           { Work area }
  287.   FileLow,                             { Work area }
  288.   FileHIgh,                            { Work area }
  289.   NumberRecs           : integer;      { How many records on disk }
  290.   FileWork3            : real;         { Work area for file size }
  291.   DiskUse              : real;         { Work area for Disk space in use }
  292.   FileUse              : integer;      { Work area for file space used }
  293.   FileUse1K            : real;         { Work area if 1K blocks }
  294.   FileUse2K            : real;         { Work area if 2K blocks }
  295.   FileUse4K            : real;         { Work area if 4K blocks }
  296.   FileUseWork          : string[11];   { Work area to print disk use }
  297.   Drive_ctr            : integer;      { Turbo 3.0 Drive letter in use}
  298.   CurDrive             : String[1];    { Turbo 3.0 Current drive }
  299.   DriveString          : string[30];   { Drive string command-line }
  300.   VolumeIdWrite        : string[16];   { VolumeID }
  301.   VolumeIdRead         : string[16];   { VolumeID }
  302.  
  303. { Changes for 2.04 include window }
  304. {$IWindo.INC}
  305. { Above Change for version 2.04 }
  306.  
  307. {$ISORT.BOX}              { This is from Borland in their Toolbox package }
  308.  
  309. procedure date;           { What is todays date }
  310. const
  311.     montharr : array [1..12] of string[3] =
  312.                ('Jan','Feb','Mar','Apr','May',
  313.                 'Jun','Jul','Aug','Sep','Oct','Nov','Dec');
  314.  
  315. var
  316.     regs:regrec;
  317.     month, day:string[2];
  318.     year:string[4];
  319.     dx, cx, result, tmpmonth:integer;
  320.  
  321. begin
  322.     with regs do
  323.     begin
  324.       ax:= $2a shl 8;
  325.     end;
  326.     msdos (regs);
  327.     with regs do
  328.     begin
  329.       str(cx:4, year);
  330.       str(dx shr 8:2, month);
  331.       str(dx mod 256:2, day);
  332.     end;
  333.     if month[1] = ' ' then month[1] := '0';
  334.     val (month, tmpmonth, result);
  335.     datestr:= day + '-' + montharr[tmpmonth] + '-' + year
  336. end; { procedure date }
  337.  
  338. {----------------------------------------------------------------------------}
  339.              { This routine gets the DOS time and makes it look good }
  340.  
  341. { Note:  The Time routine which is used here was picked up on a bulletin
  342.          board and it has some bugs in it when the time was around midnight
  343.          and around noon.  (12 midnight is 12 am and noon is 12 pm)  This
  344.          routine works to the best of my understanding }
  345. { Modified in version 2.05 }
  346.  
  347. procedure time;               { What is the current time }
  348. var                           { Not on your watch! in the computer }
  349.   regs:regrec;
  350.   ah, al, ch, cl, dh:byte;
  351.   hour, min, sec, ampm:string[2];
  352.   tmptime, result:integer;
  353.  
  354. begin
  355.   ah := $2c;
  356.   with regs do
  357.   begin
  358.     ax := ah shl 8 + al;
  359.   end;
  360.   intr($21,regs);
  361.   with regs do
  362.   begin
  363.     str(cx shr 8:2, hour);
  364.     str(cx mod 256:2, min);
  365.     str(dx shr 8:2, sec);
  366.   end;
  367.   if (hour > '11') then
  368.     ampm := 'pm'
  369.   else
  370.     ampm := 'am';
  371.   if (hour < ' 1') then
  372.     begin
  373.       ampm := 'am';
  374.       hour := '12';
  375.     end;
  376.   if (hour > '12') then
  377.     begin
  378.       val (hour, tmptime, result);
  379.       tmptime:= tmptime - 12;
  380.       str (tmptime:2, hour);
  381.     end;
  382.   if (min[1] = ' ') then
  383.     min[1]:= '0';
  384.   if (sec[1] = ' ') then
  385.     sec[1]:= '0';
  386.   timestr := hour + ':' + min + ':' + sec + ' ' + ampm;
  387. end; { procedure time }
  388.  
  389. {----------------------------------------------------------------------------}
  390.             { This routine reads the volume id in a directory }
  391.      { Written by Karson Morrison Caleb Computing Center  Numbers 13:30 }
  392.  
  393. procedure ReadVolume(DriveWanted:char);
  394. var i,a : integer;
  395. begin
  396.   VolumeIDWrite := DriveWanted + ':\????????.???' + chr(0);
  397.   for i := 1 to length(VolumeIDWrite) do
  398.     Mask[i] := VolumeIDWrite[i];
  399.   VolumeIDRead := '           ';
  400.   Regs.AX := $4E00;             { Get first directory entry }
  401.   Regs.DS := Seg(Mask);         { Point to the file Mask }
  402.   Regs.DX := Ofs(Mask);
  403.   Regs.CX := 8;                 { Store the option for Volume label }
  404.   MSDos(Regs);                  { Execute MSDos call }
  405.   Error := Regs.AX and $FF;     { Get Error return }
  406.   a := 0;
  407.   if error = 0 then
  408.   for i := 1 to 12 do
  409.     if i <> 9 then
  410.       begin
  411.          a := a + 1;
  412.          VolumeIDRead[a] := Chr(Mem[Seg(DTA):Ofs(DTA)+29+i]);
  413.       end;
  414.   for i := 1 to 12 do
  415.     if VolumeIDRead[i] = Chr(0) then
  416.        VolumeIDRead[i] := ' ';
  417. { new routine in version 3.02 for spaces in middle of vol-id }
  418.   i := 11;
  419.   repeat
  420.     if VolumeIDRead[i] = ' ' then
  421.       i := i - 1
  422.     else
  423.     begin
  424.        VolumeIdRead[0] := Chr(i);
  425.        i := 1;
  426.     end;
  427.   until i = 1;
  428. { end of new routine for version 3.02 }
  429. end;
  430.  
  431. {----------------------------------------------------------------------------}
  432.             { This routine writes the volume id to a disk }
  433.       { Written by Karson Morrison Caleb Computing Center   Numbers 13:30 }
  434.  
  435. procedure WriteVolume(DriveWanted :char);
  436. var i,a : integer;
  437. begin
  438.   VolumeIDWrite := DriveWanted + ':' + VolumeIDWrite + chr(0);
  439.   a := 0;
  440.   for i := 1 to length(VolumeIDWrite) do
  441.    if i <> 11 then
  442.    begin
  443.      a := a + 1;
  444.      Mask[a] := VolumeIDWrite[i];
  445.    end
  446.    else
  447.    begin
  448.      a := a + 1;
  449.      Mask[a] := '.';
  450.      a := a + 1;
  451.      Mask[a] := VolumeIDWrite[i];
  452.    end;
  453.   Regs.AX := $3C00;             { Create file }
  454.   Regs.DS := Seg(Mask);         { Point to the file Mask }
  455.   Regs.DX := Ofs(Mask);
  456.   Regs.CX := 8;                 { Store the option for Volume label }
  457.   MSDos(Regs);                  { Execute MSDos call }
  458.   Regs.BX := Regs.AX;           { Put file handle in BX }
  459.   Regs.AX := $3E00;             { Close the file }
  460.   MSDos(Regs);                  { Execute MSDos call }
  461.   Error := Regs.AX and $FF;     { Get Error return }
  462. end;
  463.  
  464. {----------------------------------------------------------------------------}
  465.  
  466. procedure SetUpDTA;
  467. begin
  468.   Regs.AX := $1A00;             { Function used to set the DTA }
  469.   Regs.DS := Seg(DTA);          { store the parameter segment in DS }
  470.   Regs.DX := Ofs(DTA);          {   "    "      "     offset in DX }
  471.   MSDos(Regs);                  { Set DTA location }
  472.   Error := Regs.AX and $FF;
  473. end;
  474.  
  475. procedure ReadFirst;
  476. begin
  477.   Regs.AX := $4E00;             { Get first directory entry }
  478.   Regs.DS := Seg(Mask);         { Point to the file Mask }
  479.   Regs.DX := Ofs(Mask);
  480.   Regs.CX := 23;                { Store the option }
  481.   MSDos(Regs);                  { Execute MSDos call }
  482.   Error := Regs.AX and $FF;     { Get Error return }
  483. end;
  484.  
  485. procedure ReadNext;
  486. begin
  487.     Error := 0;
  488.     Regs.AX := $4F00;           { Function used to get the next }
  489.                                 { directory entry }
  490.     Regs.CX := 23;              { Set the file option }
  491.     MSDos( Regs );              { Call MSDos }
  492.     Error := Regs.AX and $FF;   { get the Error return }
  493. end;
  494.  
  495. procedure SetUpNamR;            { Get the file name from the directory }
  496. begin
  497.     repeat
  498.       NamR[I] := Chr(Mem[Seg(DTA):Ofs(DTA)+29+I]);
  499.       I := I + 1;
  500. { Changes for version 2.01 follow this note
  501.      Changes made by the author   }
  502.     until not (NamR[I-1] in [' '..#$7F]) or (I>20); { Note: The second item }
  503.                                      { being compared as in [' '..#$7F] is  }
  504.                                      { the 7Fh char DEL }
  505. { Changes for version 2.01 are in front of this note }
  506.  
  507.   NamR[0] := Chr(I-1);          { set string length because assigning }
  508.                                 { by element does not set length }
  509. end;
  510.  
  511. procedure Set_up_Dir_Chg;       { Get a new directory from the table }
  512. var
  513.   temp : string[50] ;
  514.   temp1 : string[50] ;
  515. begin
  516.     E_use := E_Use + 1;
  517.     temp := DirTable[E_use];
  518.     temp1 := temp;
  519.     if temp[2] <> ':' then
  520.       temp := CurDrive + ':' + temp;
  521.     temp[1] := CurDrive ;
  522.     DirTable[E_use] := temp;
  523.     Buffer := DirTable[E_use] + '\????????.???' + Chr( 0); {3.0}
  524.     Buffer1 := DirTable[E_use];
  525.     GoToXY(1,YDir+1);
  526.     ClrEol;
  527.     Writeln(Buffer1);
  528.     XDir := XDir + 1;
  529.     if XDir > 75 then begin
  530.       XDir := Z;
  531.       Z := Z+1;
  532.     end;
  533.     if Z > 75 then begin
  534.       Z := 26;
  535.       XDir := 25;
  536.     end;
  537.     GoToXY(XDir,YDir);
  538.     if (Z and 1) = 0 then Write('.')     { This puts a . on the screen each }
  539.        else Write('*');                  { This puts a * on the screen each }
  540.     if length(Buffer1) = 1 then Buffer1 := '';
  541.     for I := 1 to length(Buffer) do
  542.       Mask[I] := Buffer[I];
  543. end;
  544.  
  545. procedure FindDate;              { Translate the Date from the Disk to }
  546. begin                            { Something readable }
  547.     FileMonth := 0;              { yyyyyyymmmmddddd  in bits}
  548.     FileDay := 0;
  549.     FileDateDos := MemW[Seg(DTA):Ofs(DTA)+24];
  550.     FileYear := FileDateDos shr 9;  { drop off the last 9 positions }
  551.     FileYear := FileYear + 80;      { years are added to base year of 1980 }
  552.     FileWork := FileDateDos shl 7;  { drop off the first 7 positions }
  553.     FileMonth := FileWork shr 12;   { now move it back to the right }
  554.     FileWork := FileDateDos shl 11; { drop off the left 11 positions }
  555.     FileDay := FileWork shr 11;     { now move back to the right }
  556. end;
  557.  
  558. procedure FindTime;              { Get the time and put it in a format that }
  559. begin                            { we can use. The Dos Format in bits is    }
  560.     FileHour := 0;               { hhhhhmmmmmmsssss }
  561.     FileMinute := 0;
  562.     FileHourDos := MemW[Seg(DTA):Ofs(DTA)+22];
  563.     FileHour := FileHourDos shr 11;     { Shift it around so the minutes and }
  564.     FileWork := FileHourDos shl 5;      { seconds disappear }
  565.     FileMinute := FileWork shr 10;
  566. end;
  567.  
  568. procedure FindSize;              { Get the file size and format it so we can }
  569. begin                            { use it                                    }
  570.     Filelow := MemW[Seg(DTA):Ofs(DTA)+26]; { Get from DTA, Low byte of size }
  571.     FileHigh := MemW[Seg(DTA):Ofs(DTA)+28]; { Get from DTA, High byte        }
  572. end;
  573.  
  574. procedure CalculateSize;
  575. begin
  576.     FileWork := DirectryRec.FileSiLow;
  577.     FileWork2 := Filework shr 15;
  578.     FileWork3 := FileWork2 * 32768.0;       { yes! Save the size             }
  579.     FileWork2 := FileWork shl 1;            { Get rid of high bit            }
  580.     FileWork := FileWork2 shr 1;            { Now back to where we were      }
  581.     FileWork3 := FileWork3 + FileWork;      { Lets add them together         }
  582.     FileWork := DirectryRec.FileSiHigh;
  583.     FileWork3 := FileWork3 + (FileWork * 65536.0);    { Make size total      }
  584. end;
  585.  
  586. procedure PrintDTA;
  587. var
  588.    FileAttr            : Byte;
  589. begin
  590.     FileAttr := Byte(Mem[Seg(DTA):Ofs(DTA)+21]);
  591.     if FileAttr > 31 then        { File Not Archived  But we won't print this }
  592.     begin
  593.       FileAttr := FileAttr - 32;
  594.     end;
  595.     DirectryRec.FileAttributes := '      ';  { Make it all spaces }
  596.     if FileAttr > 15 then        { This is a directory entry      }
  597.     begin                        { Let's do it to it              }
  598.       FileAttr := FileAttr - 16;
  599.       E := E + 1;
  600.       Buffer2 := Buffer1;
  601.       A := Length(Buffer2) + 1;
  602.       B := Length(NamR);
  603.       C := 1;
  604.       Buffer2[A] := '\';
  605.       repeat
  606.         A := A + 1;
  607.         Buffer2[A] := NamR[C];
  608.         C := C + 1;
  609.       until C > B;
  610.       if Buffer2[2]<>':' then
  611.           Buffer2 := CurDrive + ':' + Buffer2;
  612.       Buffer2[0] := Chr(A - 1);
  613.       DirectryRec.FileAttributes[4] := '*';      { Sub Directry }
  614.       DirTable[ E ] := Buffer2;
  615.     end;
  616.     if FileAttr > 7 then
  617.     begin
  618.       FileAttr := FileAttr - 8
  619.     end;
  620.     if FileAttr > 3 then
  621.     begin
  622.       DirectryRec.FileAttributes[3] := 'S';  { System File }
  623.       FileAttr := FileAttr - 4;
  624.     end;
  625.     if FileAttr > 1 then
  626.     begin
  627.        DirectryRec.FileAttributes[2] := 'H'; { Hidden File }
  628.        FileAttr := FileAttr - 2;
  629.     end;
  630.     if FileAttr > 0 then
  631.     begin
  632.        DirectryRec.FileAttributes[1] := 'R'; { Read Only }
  633.     end;
  634. end;
  635.  
  636. procedure FormatAndReleaseSort;  { Yep that is what it is }
  637. begin
  638.      DirectryRec.FileDrive := CurDrive;
  639.      DirectryRec.FileNme := '             ';  { Blank it out }
  640.      DirectryRec.FileNme := NamR;        { Get file name }
  641.      DirectryRec.FileNme[0] := Chr(13);  { Now make it 13 long }
  642.      if HardDrive then
  643.         DirectryRec.FileDir := Buffer1   { Get Directory its in }
  644.      else
  645.         DirectryRec.FileDir := CurDrive + ':' + VolumeIdRead +
  646.             copy(Buffer1,3,48);
  647.      FindDate;                           { Make date readable  }
  648.      FindTime;                           { Time also }
  649.      FindSize;                           { File size }
  650.      DirectryRec.FileMO := FileMonth;    { Complete setting up }
  651.      DirectryRec.FileDA := FileDay;      { Sort Record }
  652.      DirectryRec.FileYR := FileYear;
  653.      DirectryRec.FileHR := FileHour;
  654.      DirectryRec.FileMN := FileMinute;
  655.      DirectryRec.FileSiLow := FileLow;
  656.      DirectryRec.FileSiHigh := FileHigh;
  657.      SortRelease(DirectryRec);           { Let'er go! }
  658. End;
  659.  
  660. function GetDrive : char;
  661. var
  662.   al : byte;
  663.   dr : char absolute al;
  664. begin
  665.   Regs.AX := $19 shl 8;                  { Get current drive letter in AL }
  666.   MsDos(Regs);
  667.   GetDrive := Chr(lo(Regs.AX) + $41);
  668. end;
  669.  
  670. procedure Inp;    { ReadDirs this procedure is forward declared in SORT.BOX }
  671. begin                            { This reads the directories and releases }
  672.                                  { to the sort }
  673.   ReadDefaultDrive := False;     { Am I reading the default drive }
  674.   if ParamCount<>0 then DriveString:=Paramstr(1)
  675.   else
  676.     begin
  677.       DriveString := GetDrive;
  678.     end;
  679.   repeat
  680.     NotDir := True;
  681.     E := 0; E_Use := 0;
  682. { new routine in version 3.02 to check if default drive is an input drive }
  683. { if yes then you must put a new floppy in for the output (if on file) }
  684.     for drive_ctr:=1 to length(DriveString) do
  685.     begin
  686.       if Upcase(DriveString[drive_ctr]) = GetDrive then
  687.          ReadDefaultDrive := True;      { yes I'm reading the default drive }
  688.       if DriveString[drive_ctr] in ['A'..'Z','a'..'z']
  689.          then   { if it is not alpha then delete (probably ':') }
  690.       else
  691.          delete(DriveString,drive_ctr,1);
  692.     end;
  693. { end of new routine for version 3.02 }
  694.     for drive_ctr:=1 to length(DriveString) do
  695.     begin
  696.       E := succ(E);
  697.       CurDrive:=UpCase(DriveString[drive_ctr]);
  698.       Buffer := CurDrive + ':';
  699.       NotDir := True;
  700.       Buffer1 := ''; Buffer2 := Buffer; DirTable[E] := Buffer;
  701.       Buffer[ length(Buffer) + 1 ] := Chr(0);
  702.       Buffer[0] := chr(length(buffer));
  703.       FillChar(DTA,SizeOf(DTA),0);      { Initialize the DTA buffer }
  704.       FillChar(Mask,SizeOf(Mask),0);    { Initialize the mask }
  705.       FillChar(NamR,SizeOf(NamR),0);    { Initialize the file name }
  706.       SetUpDTA;
  707.       Error := 0;
  708.       if not HardDrive then
  709.       begin
  710.          VolumeIdRead := '';
  711.          FloppyNumber := FloppyNumber + 1;
  712.          ReadVolume(CurDrive);
  713.          if error <> 0 then
  714.          begin
  715.             GoToXY(1,20);
  716.             Write('Volume-ID not present.  Drive ',CurDrive,':  ');
  717.             Write('What ID do you want -----------');
  718.             GoToXY(1,21);
  719.             Write('Press return if Volume-ID not wanted!');
  720.             GoToXY(55,20);
  721.             Readln(VolumeIDWrite);
  722.             GoToXY(1,21); ClrEol; GoToXY(1,20); ClrEol;
  723.             if length(VolumeIDWrite) <> 0 then
  724.             begin
  725.                for i := 1 to length(VolumeIDWrite) do
  726.                   VolumeIDWrite[i] := Upcase(VolumeIDWrite[i]);
  727.                VolumeIDRead := VolumeIdWrite;
  728.                WriteVolume(CurDrive);
  729.             end
  730.             else
  731.             begin
  732.                Str(FloppyNumber:3,VolumeIDRead);
  733.                VolumeIDRead := 'Floppy' + VolumeIDRead;
  734.             end;
  735.           end;
  736.       end;
  737.       While E_Use < E do
  738.       begin
  739.            Set_Up_Dir_Chg;
  740.            ReadFirst;                { This does the first read for a directory }
  741.            if (Error = 0) then
  742.            begin
  743.                 I := 1;
  744.                 SetUpNamR;
  745.                 if NamR[1] = '.' then NotDir := False;
  746.                 if NotDir and  (Error = 0) then
  747.                 begin
  748.                     PrintDTA;             { This gets the file attributes }
  749.                     FormatAndReleaseSort; { Build the record }
  750.                 end;
  751.            end;
  752.            while (Error = 0) do begin
  753.              NotDir := True;
  754.              ReadNext;               { This reads other entries in directory but }
  755.              if (Error = 0) then     { the first }
  756.              begin
  757.                  I := 1;
  758.                  SetUpNamR;
  759.                  if NamR[1] = '.' then NotDir := False; { Is it a dot directory }
  760.                  if NotDir and (Error = 0) then         { No it is not }
  761.                  begin
  762.                      PrintDTA;
  763.                      FormatAndReleaseSort;
  764.                  end;
  765.              end;
  766.            end;
  767.       end;
  768.     end;
  769.   if not HardDrive then
  770.   begin                     { Only ask the following question if floppies }
  771.       GoToXY(1,18); ClrEol;
  772.       Write('Press Return when next floppy ready. (Enter (*) when done!)');
  773.       Read(Kbd,Option1);
  774.       if Option1 <> '*' then
  775.       begin
  776.          GoToXY(1,18); ClrEol;
  777.          Write('Reading the Directories');
  778.       end;
  779.   end
  780.   else
  781.     Option1 := '*';            { This is a hard disk therefore only read once }
  782.   until Option1 = '*';
  783.   Writeln;                       { All done reading the directories }
  784.   Write('Sorting the Directory Data');
  785.   ClrEol;
  786. end;                             { End of procedure Inp  }
  787.  
  788. function Less; { this boolean function has two parameters, X and Y }
  789.               { and is forward declared in SORT.BOX }
  790. var
  791.   FirstDir      : DirRec absolute X;
  792.   SecondDir     : DirRec absolute Y;
  793. begin
  794.   if option = '4' then             { Tree Directory option }
  795.   begin
  796.       Less := (FirstDir.FileDrive < SecondDir.FileDrive)
  797.                              or
  798.              ((FirstDir.FileDrive = SecondDir.FileDrive)                  and
  799.               (FirstDir.FileDir < SecondDir.FileDir))
  800.                              or
  801.              ((FirstDir.FileDrive = SecondDir.FileDrive)                  and
  802.               (FirstDir.FileDir = SecondDir.FileDir)                      and
  803.               (FirstDir.FileAttributes[4] < SecondDir.FileAttributes[4]))
  804.                                   { FileAttr[4] is the sub dir code pos }
  805.                              or
  806.              ((FirstDir.FileDrive = SecondDir.FileDrive)                  and
  807.               (FirstDir.FileDir = SecondDir.FileDir)                      and
  808.               (FirstDir.FileAttributes[4] = SecondDir.FileAttributes[4])  and
  809.               (FirstDir.FileNme < SecondDir.FileNme));
  810.   end
  811.   else                  { Sorted file option }
  812.   begin                                  { this tells the sort which of the }
  813.       Less := (FirstDir.FileNme < SecondDir.FileNme)      { two entries are }
  814.                             or
  815.              ((FirstDir.FileNme = SecondDir.FileNme) and  { first and which }
  816.               (FirstDir.FileDir < SecondDir.FileDir));    { is second }
  817.   end;
  818. end;
  819.  
  820. procedure SetUpOldArea;                { We need to keep the old }
  821. begin                                  { Stuff around to see if  }
  822.      OldName := DirectryRec.FileNme;   { Matches the new stuff   }
  823.      OldDir  := DirectryRec.FileDir;   { This is used for the duplicate }
  824.      OldAttr := DirectryRec.FileAttributes;  { compares }
  825.      OldDA := DirectryRec.FileDA;
  826.      OldMO := DirectryRec.FileMO;
  827.      OldYR := DirectryRec.FileYR;
  828.      OldHR := DirectryRec.FileHR;
  829.      OldMN := DirectryRec.FileMN;
  830.      CalculateSize;
  831.      OldSI := FileWork3;
  832. end;
  833.  
  834. procedure FixMinute;             { Make the time readable }
  835. begin                            { put a 0 in front of one }
  836.     if length(WrkMN) = 1 then    { character minutes }
  837.     begin
  838.        WrkMN := '0' + WrkMn;
  839.    end;
  840. end;
  841.  
  842. procedure HeadingDupe;           { Headings for the reports }
  843. begin
  844.      PageNoDup := PageNoDup + 1;
  845.      Writeln(FilVar,'');
  846.      Write(FilVar,'   Directory list for duplicate files.   ',Datestr,' ',Timestr);
  847.      Writeln(FilVar,'  Page ',PageNoDup);
  848.      Writeln(FilVar,'      * = Sub Dir: R = Read only; H = Hidden: S = System');
  849.      Writeln(FilVar,'      Files          Date   Time      Size     Directory ');
  850.      WriteLn(FilVar,'');
  851. end;
  852.  
  853. procedure HeadingAll;            { Heading for the reports }
  854. begin
  855.      PageNo := PageNo + 1;
  856.      Writeln(FilVar1,'');
  857.      Write(FilVar1,'      Directory list for all files.      ',Datestr,' ',Timestr);
  858.      Writeln(FilVar1,'  Page ',PageNo);
  859.      Writeln(FilVar1,'      * = Sub Dir: R = Read only: H = Hidden: S = System');
  860.      Writeln(FilVar1,'      Files          Date   Time      Size     Directory ');
  861.      WriteLn(FilVar1,'');
  862. end;
  863.  
  864. procedure HeadingTree;            { Heading for the Tree reports }
  865. begin
  866.      PageNo := PageNo + 1;
  867.      Writeln(FilVar,'');
  868.      Write(FilVar,'  Tree Directory list for all files.      ',Datestr,' ',Timestr);
  869.      Writeln(FilVar,'  Page ',PageNo);
  870.      Writeln(FilVar,'      * = Sub Dir: R = Read only: H = Hidden: S = System');
  871.      Writeln(FilVar,'      Files          Date   Time      Size');
  872. end;
  873.  
  874. Procedure SetUpOutputFile;        { This routine created in version 3.02 }
  875. begin                             { it was in the main section until now }
  876.  { following instruction added in version 3.02 }
  877.   FreeMem(SaveFile,6000);
  878.  { above instruction added in 3.02 }
  879.   MkWin(20,7,60,13,2,14,1);
  880.   Print := False;
  881.   DiskOutput := False;
  882.   if Option = '3' then
  883.   begin
  884.       Print := True;
  885.       DiskOutput := True;
  886.       Assign(FilVar,'DUPLICAT.DTA');
  887.       Assign(FilVar1,'DIRECTRY.DTA');
  888. { new routine for version 3.02 }
  889.       if ReadDefaultDrive and not HardDrive then
  890.       begin
  891.         Writeln('Place empty floppy in Drive ',GetDrive,':');
  892.         Write('Press any key to continue');
  893.         repeat until keypressed;
  894.       end;
  895. { end of new routine }
  896.       Writeln;
  897.       Writeln('Duplicate output on DUPLICAT.DTA');
  898.       Writeln('Directory output on DIRECTRY.DTA');
  899.       Rewrite(FilVar);
  900.       Rewrite(FilVar1);
  901.       TimeDelay(5);                                     { Wait 5 seconds }
  902.       RmWin;
  903.   end
  904.   else
  905.   begin
  906.       Writeln(' For Output on printer:------------(P)');
  907.       Writeln(' For Output in file DIRECTRY.DTA:--(F)');
  908.       Writeln(' For Output on screen:-------------(S)');
  909.       Writeln;
  910.       repeat
  911.          GoToXY(5,5);
  912.          Write('Option:');
  913.          read(Kbd,Option1);
  914.          Writeln(Upcase(Option1));
  915.       until Upcase(Option1) in ['P','F','S'];
  916.       RmWin;
  917.       if Upcase(Option1) = 'P' then
  918.       begin                          { Set up printer for listing }
  919.           Print := True;
  920.           if Option in ['1','4'] then
  921.           begin
  922.              Assign(FilVar,'LST:');
  923.              Rewrite(FilVar);
  924.           end
  925.           else
  926.           begin
  927.              Assign(FilVar1,'LST:');
  928.              Rewrite(Filvar1);
  929.           end;
  930.       end;
  931.       if Upcase(Option1) = 'F' then
  932.       begin                          { Set up file for listing }
  933.           Print := True;
  934.           DiskOutput := True;
  935.           if Option in ['1','4'] then
  936.           begin
  937. { new routine for version 3.02 }
  938.              MkWin(20,7,60,13,2,14,1);
  939.              if ReadDefaultDrive and not HardDrive then
  940.              begin
  941.                Writeln('Place empty floppy in Drive ',GetDrive,':');
  942.                Write('Press any key to continue');
  943.                repeat until keypressed;
  944.              end;
  945. { end of new routine }
  946.              Assign(FilVar,'DIRECTRY.DTA');
  947.              Rewrite(FilVar);
  948.              RmWin;
  949.           end
  950.           else
  951.           begin
  952. { new routine for version 3.02 }
  953.              MkWin(20,7,60,13,2,14,1);
  954.              if ReadDefaultDrive and not HardDrive then
  955.              begin
  956.                Writeln('Place empty floppy in Drive ',GetDrive,':');
  957.                Write('Press any key to continue');
  958.                repeat until keypressed;
  959.              end;
  960. { end of new routine }
  961.              Assign(FilVar1,'DIRECTRY.DTA');
  962.              Rewrite(Filvar1);
  963.              RmWin;
  964.           end;
  965.       end;
  966.       if Upcase(Option1) = 'S' then
  967.       begin                          { Set up file for listing }
  968.           if Option in ['1','4'] then
  969.           begin
  970.              Assign(FilVar,'CON:');
  971.              Rewrite(FilVar);
  972.           end
  973.           else
  974.           begin
  975.              Assign(FilVar1,'CON:');
  976.              Rewrite(Filvar1);
  977.           end;
  978.       end;
  979.   end;
  980. end;
  981.  
  982. procedure OutP; { this procedure is forward declared in SORT.BOX }
  983. begin                            { This takes the sorted data and creates }
  984. { CLRSCR instruction moved later in version 3.00  }
  985. { the following is a new instruction for version 3.02 }
  986.    SetUpOutputFile;              { Prepare for output file }
  987.    OldName := '           ';     { Clear out the field }
  988.    NumberRecs := 0;
  989.    OldDir := '            ';
  990.    DirCont := False;
  991.    Buffer[3] := chr(0);          { Shorten the drive identifier here }
  992.    Buffer[0] := chr(2);
  993.    if print then
  994.    begin
  995. { following instruction added in version 3.00  }
  996.        GoToXY(1,19); ClrEol;
  997.        GoToXY(1,18); ClrEol;
  998.        GoToXY(1,17); ClrEol;
  999. { above instruction added in version 3.00  }
  1000.        if DiskOutput then
  1001.        begin
  1002.           Write(' Creating the file DIRECTRY.DTA');
  1003.        end
  1004.        else
  1005.        begin
  1006.           Write(' Printing the Report '); { Screen }
  1007.        end;
  1008.    end
  1009. { following instructions were added or moved in version 3.00 }
  1010.    else
  1011.    begin
  1012.        ClrScr;                       { the required reports (Screen or Paper) }
  1013.    end;
  1014. { above instructions were added or moved in version 3.00  }
  1015.    if Option in ['1','3'] then
  1016.         HeadingDupe;              { Do you want the Duplicate }
  1017.    if Option in ['2','3'] then
  1018.         HeadingAll;               { Do you want all the Directories }
  1019.    if Option = '4' then
  1020.         HeadingTree;              { Do you want the Tree Dir }
  1021.    repeat
  1022.        SortReturn(DirectryRec);         { Hay it's back, just like magic }
  1023.        NumberRecs := NumberRecs + 1;
  1024.        CalculateSize;
  1025.        DiskUse := DiskUse + FileWork3;
  1026.        FileUse := DirectryRec.FileSiLow;  { Lets play with the bits }
  1027.        FileWork := FileUse and 1023;     { Turn off all bits but less than 1K }
  1028.        FileWork2 := FileUse shr 10;      { Shift the 1K multiple into place }
  1029.        if FileWork <> 0 then                     { If not exact 1K alignment }
  1030.           FileUse1K := FileUse1k + FileWork2 + 1  { Then add 1 and save }
  1031.        else                                       { If exact 1K alignment }
  1032.           FileUse1K := FileUse1K + FileWork2;     { Just keep the multiple }
  1033.        FileWork := FileUse and 2047;     { Turn off all bits but less than 2K }
  1034.        FileWork2 := FileUse shr 11;      { Shift the 2K multiple into place }
  1035.        if FileWork <> 0 then                     { If not exact 2K alignment }
  1036.           FileUse2K := FileUse2k + FileWork2 + 1  { Then add 1 and save }
  1037.        else                                       { If exact 2K alignment }
  1038.           FileUse2K := FileUse2K + FileWork2;     { Just keep the multiple }
  1039.        FileWork := FileUse and 4095;     { Turn off all bits but less then 4K }
  1040.        FileWork2 := FileUse shr 12;      { Shift the 4K multiple into place }
  1041.        if FileWork <> 0 then                     { If not exact 4K alignment }
  1042.           FileUse4K := FileUse4K + FileWork2 + 1  { Then add 1 and save }
  1043.        else                                       { If exact 4K alignment }
  1044.           FileUse4K := FileUse4K + FileWork2;     { Just keep the multiple }
  1045.        FileUse := DirectryRec.FileSiHigh;         { Now get the high byte }
  1046.        FileUse1K := FileUse1K + (FileUse * 64);   { Save the 1K multiple }
  1047.        FileUse2K := FileUse2K + (FileUse * 32);   { Save the 2K multiple }
  1048.        FileUse4K := FileUse4K + (FileUse * 16);   { Save the 4K multiple }
  1049.        if Option in ['1','3'] then         { You want the Duplicate entries }
  1050.        begin
  1051.             WorkName := DirectryRec.FileNme;
  1052.             if OldName < WorkName then     { its not duplicate }
  1053.             begin
  1054.                 SetUpOldArea;
  1055.                 if MatchFound then
  1056.                 begin
  1057.                     MatchFound := False;
  1058.                     Writeln(FilVar,'');
  1059.                     ScreenLines := ScreenLines + 1;
  1060.                 end;
  1061.             end
  1062.             else                          { Yes it is }
  1063.             begin
  1064.                 if not MatchFound then
  1065.                 begin
  1066.                      if ((print) and (ScreenLines > 50))  { 50 on paper is ok }
  1067.                       or ((not print) and (ScreenLines > 17)) then
  1068.                      begin                     { 17 is about all you want }
  1069.                          if print then         { on the screen at a time }
  1070.                          begin
  1071.                              Writeln(FilVar,#$0C);
  1072.                          end
  1073.                          else
  1074.                          begin
  1075.                              Write('                             More');
  1076.                              repeat until keypressed;
  1077.                                              { I'll wait until you read these }
  1078.                              ClrScr;         { Lets start anew }
  1079.                          end;
  1080.                          HeadingDupe;        { Put the heading back }
  1081.                          ScreenLines := 0;   { I got nothing on the screen }
  1082.                      end;
  1083.                      Write(FilVar,OldAttr);  { Write the old data }
  1084.                      Write(FilVar,OldName,' ');
  1085.                      Write(FilVar,OldMO:2,'/',OldDA:2,'/',OldYR);
  1086.                      Str(OldMN,WrkMN);       { Convert numeric to string }
  1087.                      FixMinute;              { now make it more readable }
  1088.                      Write(FilVar,' ', OldHR:2,':',WrkMN);
  1089.                      Write(FilVar,' ');      { Continue printing }
  1090.                      Write(FilVar,OldSI:9:0);  { Print Size }
  1091.                      Write(FilVar,' ');      { Continue printing }
  1092.                      if length(OldDir) > 0 then   { Is it the main directory }
  1093.                          Writeln(FilVar,OldDir)   { Nope }
  1094.                      else
  1095.                          Writeln(FilVar,'\');   { this is the main directory }
  1096.                      ScreenLines := ScreenLines + 1; { Its one more than it was }
  1097.                 end;
  1098.                 Write(FilVar,DirectryRec.FileAttributes); { Lets write the current }
  1099.                 Write(FilVar,DirectryRec.FileNme,' ');    { Record }
  1100.                 Write(FilVar,DirectryRec.FileMO:2,'/');
  1101.                 Write(FilVar,DirectryRec.FileDA:2,'/');
  1102.                 Write(FilVar,DirectryRec.FileYR);
  1103.                 Str(DirectryRec.FileMN, WrkMN);
  1104.                 FixMinute;
  1105.                 Write(FilVar,' ',DirectryRec.FileHR:2,':',WrkMN);
  1106.                 Write(FilVar,' ');
  1107.                 Write(FilVar,FileWork3:9:0);
  1108.                 Write(FilVar,' ');
  1109.                 if length(DirectryRec.FileDir) > 1 then
  1110.                     Writeln(FilVar,DirectryRec.FileDir)
  1111.                 else
  1112.                     Writeln(FilVar,'\');      { this is the main directory }
  1113.                 ScreenLines := ScreenLines + 1;
  1114.                 SetUpOldArea;
  1115.                 MatchFound := True;
  1116.             end;
  1117.        end;
  1118.        if Option in ['2','3'] then      { You want them all }
  1119.        begin
  1120.            if ((print) and (ScreenLines1 > 50))
  1121.             or ((not print) and (ScreenLines1 > 18)) then
  1122.            begin
  1123.                 if print then
  1124.                 begin
  1125.                     Writeln(FilVar1,#$0C);
  1126.                 end
  1127.                 else
  1128.                 begin
  1129.                     Write('                             More');
  1130.                     repeat until keypressed;
  1131.                     ClrScr;
  1132.                 end;
  1133.                 HeadingAll;
  1134.                 ScreenLines1 := 0;
  1135.            end;
  1136.            Write(FilVar1,DirectryRec.FileAttributes);
  1137.            Write(FilVar1,DirectryRec.FileNme,' '); { Let's show'em what we found }
  1138.            Write(FilVar1,DirectryRec.FileMO:2,'/');
  1139.            Write(FilVar1,DirectryRec.FileDA:2,'/');
  1140.            Write(FilVar1,DirectryRec.FileYR);
  1141.            Str(DirectryRec.FileMN, WrkMN);
  1142.            FixMinute;
  1143.            Write(FilVar1,' ',DirectryRec.FileHR:2,':',WrkMN);
  1144.            Write(FilVar1,' ');
  1145.            Write(FilVar1,FileWork3:9:0);
  1146.            Write(FilVar1,' ');
  1147.            if length(DirectryRec.FileDir) > 1 then
  1148.                Writeln(FilVar1,DirectryRec.FileDir)
  1149.            else
  1150.                Writeln(FilVar1,'\');
  1151.            ScreenLines1 := ScreenLines1 + 1;
  1152.        end;
  1153.        if Option = '4' then
  1154.        begin
  1155.            if ((print) and (ScreenLines > 50))
  1156.              or ((not print) and (ScreenLines > 18))
  1157.               or ((not print) and (ScreenLines > 15)
  1158.                  and (OldDir <> DirectryRec.FileDir)) then
  1159.            begin
  1160.                 if print then
  1161.                 begin
  1162.                     Writeln(FilVar,#$0C);
  1163.                 end
  1164.                 else
  1165.                 begin
  1166.                     Write('                             More');
  1167.                     repeat until keypressed;
  1168.                     ClrScr;
  1169.                 end;
  1170.                 HeadingTree;
  1171.                 ScreenLines := 0;
  1172.                 if OldDir = DirectryRec.FileDir then
  1173.                 begin
  1174.                    DirCont := True;
  1175.                    OldDir := '         ';
  1176.                 end;
  1177.            end;
  1178.            if OldDir <> DirectryRec.FileDir then   { print the dir were in }
  1179.            begin
  1180.                Writeln(FilVar,'');
  1181.                Write(FilVar,'  Directory ');
  1182.                begin
  1183.                    if length(DirectryRec.FileDir) > 1 then
  1184.                        Write(FilVar,DirectryRec.FileDir)
  1185.                    else
  1186.                        Write(FilVar,'\');
  1187.                end;
  1188.                if DirCont then
  1189.                begin
  1190.                   DirCont := False;
  1191.                   Writeln(FilVar,'    (cont.)');
  1192.                end
  1193.                else
  1194.                Writeln(FilVar,'');
  1195.                OldDir  := DirectryRec.FileDir;
  1196.                Writeln(FilVar,'');
  1197.                ScreenLines := ScreenLines + 3;
  1198.            end;
  1199.            Write(FilVar,DirectryRec.FileAttributes);
  1200.            Write(FilVar,DirectryRec.FileNme,' '); { Let's show'em what we found }
  1201.            Write(FilVar,DirectryRec.FileMO:2,'/');
  1202.            Write(FilVar,DirectryRec.FileDA:2,'/');
  1203.            Write(FilVar,DirectryRec.FileYR);
  1204.            Str(DirectryRec.FileMN, WrkMN);
  1205.            FixMinute;
  1206.            Write(FilVar,' ',DirectryRec.FileHR:2,':',WrkMN);
  1207.            Write(FilVar,' ');
  1208.            Writeln(FilVar,FileWork3:9:0);
  1209.            ScreenLines := ScreenLines + 1;
  1210.        end;
  1211.    until SortEOS;                { Do it until its done }
  1212. end;
  1213.  
  1214.  
  1215. begin                   {  Main program  }
  1216.   ClrScr;
  1217.   Buffer := '';
  1218.   DiskUse := 0;                        { Zero out field }
  1219.   FileUse := 0;
  1220.   FileUse1K := 0;
  1221.   FileUse2K := 0;
  1222.   FileUse4K := 0;
  1223.   FloppyNumber := 0;
  1224.   Time;                                 { Get the time }
  1225.   Date;                                 { Get the date }
  1226. { new instruction for version 3.02 }
  1227.   GetMem(SaveFile,6000);                { Save 6000 bytes from the sort }
  1228.                                         { for use when a file is opened }
  1229.   FirstTime := True;                    { First time here }
  1230.   MatchFound := False;                  { Haven't found any matches yet }
  1231.   GoToXY(10,1);                         { Fill the screen with data }
  1232.   Write('Directory List Program   Version 3.02'); { This is it }
  1233.   GoToXY(10,3);
  1234.   Write('Written and Copyright (C) by');
  1235.   GoToXY(18,6);
  1236.   Write('Karson W. Morrison');          { This is who did it }
  1237.   GoToXY(38,7);
  1238.   Write('Caleb Computing Company      Numbers 13:30');
  1239.   GoToXY(38,8);
  1240.   Write('Rd 1, Box 531, Ringoes New Jersey,   08551');
  1241.   GoToXY(18,9);
  1242.   Write('January  15, 1986');           { And When }
  1243.   GoToXY(10,11);
  1244.   Write('OPTIONS:');
  1245.   GoToXY(11,12);
  1246.   Write('List only Duplicate files on the disk : (1)');
  1247.   GoToXY(11,13);
  1248.   Write('List the entire Directory of the disk : (2)');
  1249.   GoToXY(11,14);
  1250.   Write('List both Directry and Duplicate files: (3)');
  1251.   GoToXY(11,15);
  1252.   Write('List a Sorted Tree Dir of the disk    : (4)');
  1253.   GoToXY(43,22);
  1254.   Write('Partial Mods. for Multiple Hard Disks');
  1255.   GoToXY(58,23);
  1256.   Write('Ray Bobak - 10/27/1985');
  1257.   repeat
  1258.      GoToXY(14,17);
  1259.      Write('Option: ');
  1260.      read(Kbd,Option);
  1261.      GoToXY(22,17);
  1262.      Writeln(Option);
  1263.   until Option in ['1'..'4'];
  1264.  
  1265.   MkWin(20,7,60,13,2,14,1);
  1266.   Writeln('Are you running this program against');
  1267.   Writeln('Floppies or a Hard Disk?  (F or H)');
  1268.   Writeln;
  1269.   Write('Option: ');
  1270.   Repeat
  1271.     Read(kbd,Option2);
  1272.   until (Upcase(Option2)) in ['F','H'];
  1273.   if Upcase(Option2) = 'H' then
  1274.      HardDrive := true
  1275.   else
  1276.      HardDrive := false;
  1277.   RmWin;
  1278.   Writeln;
  1279.   ScreenLines := 0;
  1280.   ScreenLines1 := 0;
  1281.   PageNo := 0;
  1282.   PageNoDup := 0;
  1283.   GoToXY(1,18);
  1284.   XDir := 25; YDir := 18; Z := 26;
  1285.   Writeln('Reading the Directories');
  1286.   Write('\');
  1287.   SortResult := TurboSort(SizeOf(DirectryRec)); { this does the call to the sort }
  1288.   if SortResult > 1 then                    { if the sort don't work   }
  1289.   begin                                     { This maybe what is wrong }
  1290.       if SortResult = 3 then Writeln('Not enouth memory for sorting');
  1291.       if SortResult = 9 then Writeln('More than 32767 records being sorted');
  1292.       if sortresult = 10 then Writeln('Disk error during sorting (bad or full)');
  1293.       if SortResult = 11 then Writeln('Read error during sort (Probably bad disk)');
  1294.       if sortResult = 12 then Writeln('File creation error (directory may be full)');
  1295.   end;
  1296.   Writeln;
  1297.   if print then
  1298.   begin
  1299.       if Option in ['1','3','4'] then
  1300.       begin
  1301.           Writeln(FilVar,'');
  1302.           Write(FilVar,'  Number of Directories: ',E-1);
  1303.           Writeln(FilVar,'  Number of Files: ',NumberRecs-E+1);
  1304.           Writeln(FilVar,'  Disk Space used           ',DiskUse:11:0);
  1305.           Writeln(FilVar,'  Disk Space used 4K blocks ',(FileUse4K * 4096.0):11:0);
  1306.           Writeln(FilVar,'  Disk Space used 2K blocks ',(FileUse2K * 2048.0):11:0);
  1307.           Writeln(FilVar,'  Disk Space used 1K blocks ',(FileUse1K * 1024.0):11:0);
  1308.           If not DiskOutput then
  1309.              Writeln(FilVar,#$0C);
  1310.       end;
  1311.       if Option in ['2','3'] then
  1312.       begin
  1313.           Writeln(FilVar1,'');
  1314.           Write(FilVar1,'  Number of Directories: ',E-1);
  1315.           Writeln(FilVar1,'  Number of Files: ',NumberRecs-E+1);
  1316.           Writeln(FilVar1,'  Disk Space used           ',DiskUse:11:0);
  1317.           Writeln(FilVar1,'  Disk Space used 4K blocks ',(FileUse4K * 4096.0):11:0);
  1318.           Writeln(FilVar1,'  Disk Space used 2K blocks ',(FileUse2K * 2048.0):11:0);
  1319.           Writeln(FilVar1,'  Disk Space used 1K blocks ',(FileUse1K * 1024.0):11:0);
  1320.           If not DiskOutput then
  1321.              Writeln(FilVar1,#$0C);
  1322.       end;
  1323.  
  1324. { the following line was changed in version 3.00 }
  1325.       GoToXY(1,19);   { this is for the Writeln below this }
  1326.   end;
  1327.   If DiskOutput then
  1328.   begin
  1329.      if Option in ['1','3','4'] then
  1330.         close(FilVar);
  1331.      if Option in ['2','3'] then
  1332.         close(Filvar1);
  1333.   end;
  1334.   Write('  Number of Directories: ',E-1);
  1335.   Write('  Number of Files: ',NumberRecs-E+1);
  1336.   ClrEol;
  1337.   Writeln;
  1338.   Writeln('  Disk Space used           ',DiskUse:11:0);
  1339.   Writeln('  Disk Space used 4K blocks ',(FileUse4K * 4096.0):11:0);
  1340.   Writeln('  Disk Space used 2K blocks ',(FileUse2K * 2048.0):11:0);
  1341.   Writeln('  Disk Space used 1K blocks ',(FileUse1K * 1024.0):11:0);
  1342. end.
  1343.